home *** CD-ROM | disk | FTP | other *** search
- # CVS $Id: beep.tcl,v 1.1 1995/02/03 17:15:13 zibi Exp $
- #!/bin/vtcl
- # Z% beep.tcl 11.2 94/08/18
- # Hops 06.24.94
- # Test program1 to exercise VtBeep Command
- # allows Beeping over valid range - select from dialog
-
- proc beepCB {cbs} {
- global vol dur ptch
-
- VtBeep -volume $vol -duration $dur -pitch $ptch
- }
-
- proc quitCB {cbs} {
- VtClose
- }
-
- proc scaleCB {var cbs} {
- global vol dur ptch
- upvar 0 $var val
-
- # puts "b4:vol=$vol, dur=$dur"
-
- set val [keylget cbs value]
- # puts "val ($var)=$val"
- # puts "vol=$vol, dur=$dur"
- }
-
- set vol 50
- set dur 100
- set ptch 800
-
-
- set app [VtOpen beeper]
-
- set form [VtFormDialog $app.form]
-
- set l [ VtLabel $form.l \
- -label "Beeper" \
- -leftSide FORM \
- -topSide FORM ]
-
- set inner1 [VtForm $form.inner1 \
- -leftSide FORM \
- -rightSide FORM ]
-
-
- # Volume scale
- set s1 [VtScale $form.inner1.svol \
- -callback "scaleCB vol" \
- -title "Volume (%)" \
- -horizontal \
- -min -100 \
- -max 100 \
- -value $vol \
- -topSide FORM \
- -leftSide FORM ]
-
-
-
- # duration scale
- set s2 [VtScale $form.inner1.sdur \
- -callback "scaleCB dur" \
- -title "duration (ms)"\
- -horizontal \
- -min 0 \
- -max 1000 \
- -value $dur \
- -topSide $s1 ]
- # pitch scale ( HZ )
- set s3 [VtScale $form.inner1.spitch \
- -callback "scaleCB ptch" \
- -title "Pitch (Hz)"\
- -horizontal \
- -min 0 \
- -max 4000 \
- -value $ptch \
- -topSide $s2 ]
-
-
-
-
- set pb1 [VtPushButton $form.pb1 \
- -label "BeepMe" \
- -callback beepCB ]
-
- set quit [VtPushButton $form.quit \
- -label "Quit"\
- -callback quitCB \
- -leftSide 50 \
- -topSide $inner1 \
- -bottomSide FORM \
- -rightSide FORM]
-
- VtShow $form
- VtMainLoop
-
-